
;; Copyright (C) Johan Ceuppens 2009 
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 2 of the License, or
;; (at your option) any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
;; p 117 BlueBook SMALLTALK-80
(defun Object (name)
  (let* ((*class "Object")
	 (*instance-name name)
	 (*indexed-variables '())


	 (*dispatch 
	  (lambda (msg)
	    (print "calling method.\n")
	    (cond ((eq msg "isKindOf:")
		   *isKindOf)
		  ((eq msg "isMemberOf:")
		   *isMemberOf)
		  ((eq msg "respondsTo:")
		   *respondsTo)
		  ((eq msg "class")
		   Object);;NOTE
		  ((or (eq msg "name") (eq msg "instance-name"))
		   (lambda () *instance-name));;NOTE
		  ((eq msg "at:")
		   *at)
		  (t		    
		   (error "Invalid method call"))
		  )))
	 
	 (*isKindOf 
	  (lambda (aClass)
	    (string= ((aClass "class")) *class)))
	 
	 (*isMemberOf 
	  (lambda (aClass)
	    (string= ((aClass "class")) *class)))
	 
;;	 (*respondsTo 
;;	  (lambda (aSymbol)
;;	    (string= (make-string aSymbol) *class)))

	 (*==;;FIXME
	  (lambda (aClass)
	    (string= *instance-name ((aClass "instance-name")))))

	 (*=;;FIXME
	  (lambda (aClass)
	    (eq aClass *dispatch)))

	 (*deepCopy 
	  (lambda ()
	    *dispatch))

	 (*at;;FIXME nullp
	  (lambda (index &optargs: put value)
	    (let ((head nil)
		  (tail *indexed-variables)		  
		  )	    
	      (count-loop (i 0 index)
			  (setq tail (cdr tail))
			  (if (eq put "put:")
			      (setq *indexed-variables (append head (list value) tail))))
	      (car tail))))
			    
			    
;;	 (*put
;;	  (lambda (index)
;;	    (count-loop (i 0 index)
;;			(cadr *indexed-variables))))

	 )
    
    *dispatch))

;;(setq o (Object "o"))
;;(print o)
;;((o "class"))
